home *** CD-ROM | disk | FTP | other *** search
/ Aminet 2 / Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso / Aminet / dev / amos / jdlib4_6.lha / Progs / JD_Datei.AMOS / JD_Datei.amosSourceCode
AMOS Source Code  |  2008-12-10  |  50KB  |  1,927 lines
  1. Set Buffer 150
  2. Break Off 
  3. VS#=0.0
  4. SETUP
  5. TMJ$= Extension_22_004C 
  6. LAST=2000 : MF=9
  7. Reserve Zone 40
  8. Dim S$(LAST),ME$(16),PO$(12),N$(MF),A$(MF),MM$(MF),A2$(MF),B$(MF),NB$(MF),SX$(MF),REP$(MF)
  9. Dim PRLEN(MF),PRAB(MF),MXLEN(MF),MXLEN2(MF),NEU(MF),MLEN(MF),PRLEN2(MF),PRAB2(MF),SB(61)
  10. Global ME$(),KK,AF,ML,NR,MX,B1,B2,SF,B1,B2,FELEN,RGBO,BC,FC,AKT
  11. Gosub CLEAR
  12. AKT=0 : SOF=0
  13. MA:
  14. Curs Off 
  15. Cls 1
  16. MA2:
  17. Ink 2 : Curs Off 
  18. B1=1 : B2=MX
  19. SF=0
  20. AUTOSAVE
  21. Restore HM : Gosub RD
  22. If AKT=0 Then If IN=3 or IN=4 or IN=5 or IN=11 or IN=12 or IN=13 or IN=15 Then AKT=1 : SOF=0 : Timer=0
  23. If AKT=0 Then If IN=8 Then AKT=1 : Timer=0
  24. On IN Goto LA,BL,DA,EG,SO,DRU,FW,UP,SP,SU,MAE,AEN,ID,FL,IM,EN
  25. UP:
  26. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  27. AUTOSAVE
  28. If SOTE=0 Then Cls 1 : Locate 1,3 : Under On : Centre "Update" : Under Off 
  29. Show : Change Mouse 3
  30. If SOTE=0 Then Print : Print : Print "Phase 1"
  31. FELEN=0
  32. For ZZX=1 To AF
  33.    FELEN=Max(Len(N$(ZZX)),FELEN)
  34.    MXLEN(ZZX)=0 : PRLEN(ZZX)=0
  35. Next ZZX
  36. If SOTE=0 Then Print "Phase 2"
  37. For NR=1 To MX
  38.    Gosub MAKEFELDER
  39.    For ZZX=1 To AF
  40.       MXLEN(ZZX)=Max(Len(A$(ZZX)),MXLEN(ZZX))
  41.       MXLEN(ZZX)=Max(Len(N$(ZZX)),MXLEN(ZZX))
  42.    Next ZZX
  43. Next NR
  44. If SOTE=0 Then Print "Phase 3"
  45.    For ZZX=1 To AF
  46.       PRLEN(ZZX)=Max(Len(N$(ZZX)),PRLEN(ZZX))
  47.       PRLEN(ZZX)=Max(PRLEN(ZZX),MXLEN(ZZX))
  48.    Next ZZX
  49. If SOTE=0 Then Print "Phase 4"
  50. Gosub LCOUNT
  51. Change Mouse 1 : Hide 
  52. If SOTE=1 Then Return Else Goto MA
  53. EN:
  54. E=0 : If AKT<>0 Then Wait 5 : REQUESTER["Programm wirklich beenden?","Ja","Nein"] : E=Param
  55. If E=2 Then Goto MA
  56. End 
  57. LA:
  58. If S$(1)<>Chr$(255) Then Goto SCHONDATEI
  59. MEMCLR:
  60. Gosub CLEAR
  61. LADEDEG:
  62. Cls 1 : Clear Key 
  63. Show 
  64. DD$=Fsel$("*.seq","","Datei","laden")
  65. Hide 
  66. If DD$="" Then Goto MA
  67. If S$(1)<>Chr$(255) Then Goto ANHAENGEN
  68. On Error Goto SPFEHLER
  69. NR=0
  70. Change Mouse 3
  71. Show 
  72. Open In 8,DD$
  73. Input #8,KENN$ : If KENN$<>"JD-Datei-Sequenz" Then Goto FALSCH
  74. Input #8,TMJ2$
  75. Input #8,SOF
  76. Input #8,AF
  77. Input #8,SN
  78. Input #8,BR
  79. For X=1 To AF
  80.    Input #8,PRLEN(X)
  81.    Input #8,PRAB(X)
  82. Next X
  83. Input #8,FELEN
  84. For X=1 To AF
  85.    Input #8,N$(X)
  86.    Input #8,MXLEN(X)
  87. Next X
  88. Input #8,DN$
  89. Input #8,MX
  90. If MX=0 Then NR=0 : Goto GELADEN
  91. B1=1 : B2=MX
  92. For NR=1 To 61
  93.    Input #8,SB(NR)
  94. Next NR
  95. For NR=1 To MX
  96.    On Error Goto LADEFEHLER
  97.    POSITION[NR]
  98.    Input #8,S$(NR)
  99. Next NR
  100. GELADEN:
  101. Close 8 : Hide : Change Mouse 1
  102. Cls 1 : Locate 5,5 : Print "Es wurde die Datei ";Chr$(34);DN$;Chr$(34);" mit";MX;" Datens�tzen geladen"
  103. If SOF=0 Then Print "Datei ist nicht sortiert" : Goto FGEL
  104. Locate 5,7 : Print "Datei ist nach Feld Nr. ";Right$(Str$(SOF),Len(Str$(SOF))-1);" in ";
  105. If SOF<0 Then Print "absteigender";
  106. If SOF>0 Then Print "aufsteigender";
  107. Print " Reihenfolge sortiert"
  108. FGEL:
  109. Locate 5,9 : Print "Die letzte Speicherung war am: ";TMJ2$
  110. Locate 5,11 : Print "Lade-Fehler:";LF
  111. Locate 5,13 : Print "Freier Speicher:";Free;" Bytes"
  112. Goto RM
  113. SCHONDATEI:
  114. Cls 1 : Locate 1,10 : Centre "Es befindet sich bereits eine Datei im Speicher!" : Print 
  115. Restore LM : Gosub RD
  116. On IN Goto MEMCLR,MA,ANHAENGEN
  117. FALSCH:
  118. Close 8 : Hide : Change Mouse 1 : Cls 1
  119. MELDUNG[DD$+" ist keine JD-Datei-Sequenz!"]
  120. Goto LA
  121. ANHAENGEN:
  122. Cls 1
  123. Show : Clear Key 
  124. DD$=Fsel$("*.seq","","Datei","anh�ngen")
  125. Hide 
  126. If DD$="" Then Goto MA
  127. On Error Goto SPFEHLER
  128. Change Mouse 3 : Show 
  129. SOF=0
  130. Open In 8,DD$
  131. Input #8,KENN$ : If KENN$<>"JD-Datei-Sequenz" Then Goto FALSCH
  132. Input #8,TMJ3$ : TMJ2$= Extension_22_03A0(TMJ3$,TMJ2$)
  133. Input #8,SOF
  134. Input #8,AF2 : If AF2>AF Then Gosub ANH2 : ZV=1
  135. Input #8,SN
  136. Input #8,BR
  137. For NR=1 To AF2
  138.    Input #8,PRLEN2(NR) : PRLEN(NR)=Max(PRLEN(NR),PRLEN2(NR))
  139.    Input #8,PRAB2(NR) : PRAB(NR)=Max(PRAB2(NR),PRAB(NR))
  140. Next NR
  141. Input #8,FELEN2 : FELEN=Max(FELEN,FELEN2)
  142. If ZV=0 Then For X=1 To AF2 : Input #8,M$ : Input #8,MXLEN2(X) : Next X
  143. If ZV=1 Then For X=1 To AF2 : Input #8,N$(X) : Input #8,MXLEN2(X) : Next X
  144. If ZV=1 Then AF=AF2 : ZV=0
  145. Input #8,DN$
  146. Input #8,MX2
  147. If MX2=0 Then NR=0 : Goto ANHEND
  148. If MX+MX2>LAST Then MX2=LAST-MX : ZV=1
  149. B1=1 : B2=MX+MX2
  150. For NR=1 To 61
  151.    Input #8,SB2
  152. Next 
  153. For NR=MX+1 To MX+MX2
  154.    On Error Goto LADEFEHLER
  155.    POSITION[NR]
  156.    Input #8,S$(NR)
  157. Next NR
  158. If AF2=>AF Then Goto ANCON
  159. For NR=MX+1 To MX+MX2
  160.    For X=AF2+1 To AF
  161.       S$(NR)=S$(NR)+" |"
  162.    Next X
  163. Next NR
  164. ANCON:
  165. For X=1 To AF
  166.    MXLEN(X)=Max(MXLEN(X),MXLEN2(X))
  167. Next X
  168. ANHEND:
  169. Close 8 : Gosub LCOUNT : Hide : Change Mouse 1
  170. MX=MX+MX2
  171. Cls 1 : Locate 5,5 : Print "Es wurde die Datei ";Chr$(34);DD$;Chr$(34);" mit";MX2;" Datens�tzen angehangen"
  172. If ZV=1 Then Print : Centre "Die komplette Datei konnte leider nicht angehangen werden!"
  173. Print : Print "Freier Speicher:";Free;" Bytes"
  174. Goto FGEL
  175. ANH2:
  176. For NR=1 To MX
  177.    For X=AF+1 To AF2
  178.       S$(NR)=S$(NR)+" |"
  179.    Next X
  180. Next NR
  181. Return 
  182. Goto LADEDEG
  183. KONV_FEHLER:
  184. Cls 1 : Home 
  185. Print : Centre "Konvertierungs-Fehler" : Gosub RY
  186. Resume Label MA
  187. LADEFEHLER:
  188. S$(NR)="Lade-Fehler"
  189. Inc LF
  190. Resume Next 
  191. SP:
  192. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  193. Cls 1
  194. If PRLEN(1)=0 Then KLARO=1 : Gosub PREF
  195. Gosub LONG
  196. SPEICHERDEG:
  197. Clear Key 
  198. Show : DD$=Fsel$("*.seq","","Datei","Speichern") : Hide 
  199. If DD$="" Then Goto MA
  200. PFAD$=Left$(DD$,Instr(DD$,":"))
  201. CUR$=Dir$
  202. Dir$=PFAD$
  203. Restore MEM
  204. Read Y
  205. MEMO=0
  206. For X=1 To Y
  207.    Read MEM$
  208.    If PFAD$=MEM$ Then MEMO=1
  209. Next 
  210. If MEMO=1 Then Goto MEMCON
  211. If DILEN+5120>Dfree Then REQUESTER["WARNUNG! Datei braucht mehr Speicherplatz als auf Disk vorhanden.","Andere Diskette eingelegt!","Abbruch!"]
  212. If Param=2 Then Goto MA
  213. MEMCON:
  214. Dir$=CUR$
  215. If Right$(DD$,4)<>".seq" Then DD$=DD$+".seq"
  216. If Exist(DD$) Then Goto DEX
  217. UEBERSCHREIBEN:
  218. On Error Goto SPFEHLER
  219. NR=0
  220. If DN$="" Then DN$=DD$
  221. SPEICHERWEITER:
  222. NR=0
  223. Change Mouse 3 : Show : Open Out 8,DD$
  224. Print #8,"JD-Datei-Sequenz"
  225. Print #8,TMJ$
  226. Print #8,SOF
  227. Print #8,AF
  228. Print #8,SN
  229. Print #8,BR
  230. For NR=1 To AF
  231.    Print #8,PRLEN(NR)
  232.    Print #8,PRAB(NR)
  233. Next NR
  234. Print #8,FELEN
  235. For NR=1 To AF
  236.    Print #8,N$(NR)
  237.    Print #8,MXLEN(NR)
  238. Next NR
  239. Print #8,DN$
  240. Print #8,MX
  241. For NR=1 To 61
  242.    Print #8,SB(NR)
  243. Next NR
  244. For NR=1 To MX
  245.    POSITION[NR]
  246.    Print #8,S$(NR)
  247. Next NR
  248. Close 8 : Hide : Change Mouse 1
  249. Cls 1 : Locate 7,5 : Print "Datei-Name: "+DN$+"  File-Name: "+DD$
  250. Locate 7,7 : Print "Es wurden";MX;" Datens�tze gesichert!"
  251. Locate 7,9 : Print "Freier Speicher:";Free;" Bytes"
  252. AKT=0 : Goto RM
  253. DEX:
  254. Cls 1 : DD2$=DD$+"-Filename ist schon vergeben!"
  255. Locate 1,10
  256. Centre DD2$
  257. Restore SM : Gosub RD
  258. Cls 1 : On IN Goto UEBERSCHREIBEN,SPEICHERDEG
  259. SPFEHLER:
  260. If Errn=81 Then Locate 1,19 : Centre "FEHLER - Volume existiert nicht!"
  261. If Errn=82 and SPI=0 Then Locate 1,19 : Centre "FEHLER - Datei existiert nicht!"
  262. If Errn=89 Then Locate 1,19 : Centre "FEHLER - Datendiskette ist voll!" : Locate 1,21 : Centre "Bitte Diskette wechseln"
  263. If Errn=87 Then Locate 1,19 : Centre "FEHLER - Device existiert nicht!"
  264. If Errn=84 Then Locate 1,19 : Centre "--- Disk ist schreibgesch�tzt ---" : Locate 1,21 : Centre "- Bitte Schreibschutz entfernen -"
  265. If Errn=95 Then Locate 19,1 : Centre "FEHLER - Device nicht ansprechbar!" : Locate 21,1 : Centre "Bitte Diskette einlegen!"
  266. P= Extension_22_01C4("")
  267. If P=27 Then Resume Label MA
  268. If Errn=82 Then Resume Label LADEDEG
  269. If Errn=87 and SPI=1 Then Resume Label SPEICHERDEG
  270. If Errn=87 Then Resume Label LADEDEG
  271. If Errn=89 Then Resume Label SPEICHERDEG
  272. If Errn=84 Then Resume Label SPEICHERDEG
  273. If Errn=81 and SPI=1 Then Resume Label SPEICHERDEG
  274. If Errn=81 Then Resume Label LADEDEG
  275. Print Errn : Error(Errn) : Stop 
  276. BL:
  277. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  278. Cls 1
  279. Restore BM : Gosub RD
  280. NR=1 : Z=1
  281. B1=1 : B2=MX
  282. On IN Goto BLALL,BLGEZ,BLBER,BLLIST,MA
  283. BLGEZ:
  284. Locate 15,15 : Print "Welcher Buchstabe? ";
  285. A$=Chr$( Extension_22_01C4("")) : Print A$
  286. Y$="0123456789 A�BCDEFGHIJKLMNO�PQRSTU�VWXYZ&!@#$%*()+-='<>?,.:;/"
  287. Z=Instr(Y$,A$)-1
  288. If SOF=1 Then If Z=0 Then NR=1 : Goto BLFIND
  289. If SOF=-1 Then Z=Z+1
  290. If Abs(SOF)=1 Then For Y=1 To Z : NR=NR+SB(Y) : Next Y
  291. If SOF=-1 Then NR=MX-NR
  292. BLFIND:
  293. If SOF=1 and(Left$(Upper$(S$(NR)),1)>A$) Then MELDUNG["Suche beendet!"] : Goto BL
  294. If SOF=-1 and(Left$(Upper$(S$(NR)),1)<A$) Then MELDUNG["Suche beendet!"] : Goto BL
  295. If Extension_22_0080(NR,1,MX)=0 Then MELDUNG["Suche beendet!"] : Goto BL
  296. POSITION[NR]
  297. If Left$(Upper$(S$(NR)),1)<>A$ Then NR=NR+Z : Goto BLFIND
  298. K1:
  299. Gosub SH
  300. GC[1] : Z=Param
  301. Gosub ZSPEC
  302. If Z=5196 or Z=5076 Then Goto K1
  303. If Z=5000 Then Goto BL
  304. NR=NR+Z
  305. Goto BLFIND
  306. BLALL:
  307. NR=Max(NR,1)
  308. NR=Min(NR,MX)
  309. K2:
  310. Gosub SH
  311. GC[1] : Z=Param
  312. Gosub ZSPEC
  313. If Z=5196 or Z=5076 Then Goto K2
  314. If Z=5000 Then Goto BL
  315. NR=NR+Z
  316. Goto BLALL
  317. BLBER:
  318. Locate 18,15 : Input "Bereich: ";BB$
  319. If BB$="" Then Goto BL
  320. Gosub BEREICH
  321. If B1=0 Then Goto BL
  322. BLBERN:
  323. NR=Max(NR,B1)
  324. NR=Min(NR,B2)
  325. K3:
  326. Gosub SH
  327. GC[1] : Z=Param
  328. Gosub ZSPEC
  329. If Z=5196 or Z=5076 Then Goto K3
  330. If Z=5000 Then Goto BL
  331. NR=NR+Z
  332. Goto BLBERN
  333. BLLIST:
  334. KK=1
  335. ANR=1
  336. BLIST:
  337. Cls 1 : Gosub BLTITEL
  338. NR=ANR
  339. NR=Min(NR,MX-19)
  340. NR=Max(NR,1)
  341. ANR=NR
  342. ZEILE=1
  343. Locate 0,2
  344. BLISNE:
  345. If ZEILE>20 Then Goto CURSOR
  346. If NR>MX Then Goto LEER
  347. Gosub MAKEFELDER
  348. Gosub BLIAUSDRUCK
  349. LEER:
  350. Print 
  351. Inc NR
  352. Inc ZEILE
  353. Goto BLISNE
  354. CURSOR:
  355. Print "Stand: ";
  356. If AKT=1 Then Print TMJ$;
  357. If AKT=0 Then Print TMJ2$;
  358. Print Space$(12);
  359. Print "Satz Nr.";ANR;" bis Satz Nr.";ANR+19
  360. Polyline 1,15 To 704,15
  361. Polyline 1,175 To 704,175
  362. GC[0] : Z=Param
  363. If Z=5000 Then Goto BL
  364. If Z=5033 Then Z=0
  365. ANR=ANR+Z
  366. Goto BLIST
  367. BLTITEL:
  368. Locate 0,1
  369. L=0
  370. For X=KK To AF
  371.    L=L+MXLEN(X)+2
  372.    If L<=84 Then ML=X
  373. Next X
  374. For X=KK To ML-1
  375.    Print N$(X);Space$(MXLEN(X)-Len(N$(X))+2);
  376. Next X
  377. Print N$(X)
  378. Return 
  379. BLIAUSDRUCK:
  380. For X=KK To ML-1
  381.    T$= Extension_22_006C(A$(X),"{",",")
  382.    Print T$;Space$(MXLEN(X)-Len(A$(X))+2);
  383. Next X
  384. T$= Extension_22_006C(A$(X),"{",",")
  385. Print T$;
  386. Return 
  387. SU:
  388. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  389. Cls 1
  390. AUTOSAVE
  391. B1=1 : B2=MX
  392. NR=0 : NLR=0
  393. SF=1
  394. Restore SUM : Gosub RD
  395. On IN Goto MA,SUOK,SUMIT
  396. SUFE:
  397. Cls 1 : Locate 1,1 : ZX=IN-3 : Print N$(ZX)+": ";
  398. IN$= Extension_22_024E("",60) : If IN$="" Then Goto SU
  399. If Extension_22_005A(IN$,"*")>2 Then Goto SU
  400. WORKING : Gosub SPECIAL
  401. JOK=0
  402. If Left$(IN$,1)="*" Then JOK=1
  403. If Left$(IN$,1)="?" Then JOK=1
  404. NR=1 : Z=1
  405. If JOK=1 Then Goto SUFENEXT
  406. Y$="0123456789 A�BCDEFGHIJKLMNO�PQRSTU�VWXYZ&!@#$%*()+-='<>?,.:;/"
  407. SZ=Instr(Y$,Left$(IN$,1))-1
  408. If SOF=ZX Then If SZ=0 Then NR=1 : Goto SUFENEXT
  409. If SOF=ZX*(-1) Then SZ=SZ+1
  410. If Abs(SOF)=ZX
  411.    For SY=1 To SZ
  412.       NR=NR+SB(SY)
  413.    Next SY
  414. End If 
  415. If SOF=ZX*(-1) Then NR=MX-NR
  416. SUFENEXT:
  417. Change Mouse 3
  418. Gosub MAKEFELDER
  419. POSITION[NR]
  420. P= Extension_22_0080(NR,1,MX)
  421. If SOF=ZX*(-1) and JOK=0 and NLR=0 Then If Left$(A$(ZX),1)<Left$(IN$,1) Then Goto SUFENICHT
  422. If SOF=ZX and JOK=0 and NLR=0 Then If Left$(A$(ZX),1)>Left$(IN$,1) Then Goto SUFENICHT
  423. If P=0 and NLR=0 Then Goto SUFENICHT
  424. If SOF=ZX*(-1) and JOK=0 Then If Left$(A$(ZX),1)<Left$(IN$,1) Then NR=NLR : Bell : Goto SUFEND
  425. If SOF=ZX and JOK=0 Then If Left$(A$(ZX),1)>Left$(IN$,1) Then NR=NLR : Bell : Goto SUFEND
  426. If P=0 Then NR=NLR : Bell : Goto SUFEND
  427. If Inkey$=Chr$(27) Then Change Mouse 1 : Goto SU
  428. IN= Extension_22_0006(Upper$(A$(ZX)),Upper$(IN$))
  429. If IN=0 Then NR=NR+Z : Goto SUFENEXT
  430. NLR=NR
  431. SUFEND:
  432. Gosub SH
  433. GC[1] : Z=Param
  434. Gosub ZSPEC
  435. If Z=5196 or Z=5076 Then Goto SUFEND
  436. If Z=5000 Then Goto SU
  437. Z=Max(Z,-1)
  438. Z=Min(Z,1)
  439. NR=NR+Z
  440. Goto SUFENEXT
  441. SUOK:
  442. Cls 1 : Locate 5,5 : Print "Such-Begriff: ";
  443. IN$= Extension_22_024E("",60) : If IN$="" Then Goto SU
  444. If Extension_22_005A(IN$,"*")>2 Then Goto SU
  445. WORKING
  446. NR=1 : Z=1
  447. SUNEXTOK2:
  448. Change Mouse 3
  449. POSITION[NR]
  450. P= Extension_22_0080(NR,1,MX) : If P=0 and NLR=0 Then Goto SUFENICHT
  451. If P=0 Then NR=NLR : Bell : Goto SUOEND
  452. If Inkey$=Chr$(27) Then Change Mouse 1 : Goto SU
  453. Gosub MAKEFELDER
  454. ZX=0
  455. SUNEXTOK:
  456. Inc ZX
  457. If ZX>AF Then NR=NR+Z : Goto SUNEXTOK2
  458. IN= Extension_22_0006(Upper$(A$(ZX)),Upper$(IN$))
  459. If IN=0 Then Goto SUNEXTOK
  460. NLR=NR
  461. SUOEND:
  462. Gosub SH
  463. GC[1] : Z=Param
  464. Gosub ZSPEC
  465. If Z=5196 or Z=5076 Then Goto SUOEND
  466. If Z=5000 Then Goto SU
  467. Z=Max(Z,-1)
  468. Z=Min(Z,1)
  469. NR=NR+Z
  470. Goto SUNEXTOK2
  471. SUMIT:
  472. Cls 1 : MM=0 : Locate 5,5
  473. JOK=0
  474. For X=1 To AF
  475.    MM$(X)=""
  476.    Print : Print N$(X)+Space$(FELEN-Len(N$(X)))+": ";
  477.    IN$= Extension_22_024E("",60) : Gosub SPECIAL
  478.    If IN$<>"" Then MM$(X)=IN$ : Inc MM
  479.    If X=Abs(SOF) and(Left$(IN$,1)="*") Then JOK=1
  480.    If X=Abs(SOF) and(Left$(IN$,1)="?") Then JOK=1
  481. Next X
  482. WORKING
  483. NR=1 : Z=1
  484. If JOK=1 Then Goto SUMITNE
  485. Follow 
  486. X=Abs(SOF)
  487. If MM$(X)="" Then Goto SUMITNE
  488. Y$="0123456789 A�BCDEFGHIJKLMNO�PQRSTU�VWXYZ&!@#$%*()+-='<>?,.:;/"
  489. SZ=Instr(Y$,Left$(MM$(X),1))-1
  490. If SOF>0 Then If SZ=0 Then NR=1 : Goto SUMITNE
  491. If SOF<0 Then SZ=SZ+1
  492. For SY=1 To SZ
  493.    NR=NR+SB(SY)
  494. Next SY
  495. If SOF<0 Then NR=MX-NR
  496. SUMITNE:
  497. Change Mouse 3
  498. POSITION[NR]
  499. Gosub MAKEFELDER
  500. P= Extension_22_0080(NR,1,MX)
  501. If SOF<0 and JOK=0 and NLR=0 Then If Left$(A$(SOF*(-1)),1)<Left$(MM$(SOF*(-1)),1) Then Goto SUFENICHT
  502. If SOF>0 and JOK=0 and NLR=0 Then If Left$(A$(SOF),1)>Left$(MM$(SOF),1) Then Goto SUFENICHT
  503. If P=0 and NLR=0 Then Goto SUFENICHT
  504. If SOF<0 and JOK=0 Then If Left$(A$(SOF*(-1)),1)<Left$(MM$(SOF*(-1)),1) Then NR=NLR : ININ=MM : Bell : Goto SUMIEND
  505. If SOF>0 and JOK=0 Then If Left$(A$(SOF),1)>Left$(MM$(SOF),1) Then NR=NLR : ININ=MM : Bell : Goto SUMIEND
  506. If P=0 Then NR=NLR : ININ=MM : Bell : Goto SUMIEND
  507. If Inkey$=Chr$(27) Then Change Mouse 1 : Goto SU
  508. ININ=0
  509. For X=1 To AF
  510.    IN=0
  511.    If MM$(X)<>"" Then IN= Extension_22_0006(Upper$(A$(X)),Upper$(MM$(X)))
  512.    If IN=1 Then Inc ININ
  513. Next X
  514. SUMIEND:
  515. If ININ<>MM Then Goto NY
  516. NLR=NR : Gosub SH : GC[1] : Z=Param : Gosub ZSPEC
  517. If Z=5196 Then Goto SUMIEND
  518. If Z=5000 Then Goto SU
  519. Z=Max(Z,-1)
  520. Z=Min(Z,1)
  521. NY:
  522. NR=NR+Z
  523. Goto SUMITNE
  524. FW:
  525. FC=2 : BC=0
  526. CHANGERGB
  527. Goto MA
  528. HCOP:
  529. PT= Extension_22_06FE 
  530. If PT<>0 Then Return 
  531. Gosub MAKEFELDER
  532. Gosub INIT
  533. Open Out 4,"PRT:"
  534. For TX=1 To AF
  535.    Print #4,"  ";
  536.    T$=N$(TX)
  537.    Gosub ADRU
  538.    Print #4,Space$(FELEN-Len(N$(TX)))+": ";
  539.    T$=A$(TX)
  540.    Gosub ADRU
  541.    Print #4,""
  542. Next TX
  543. Print #4,""
  544. Close 4
  545. Return 
  546. ADRU:
  547. T$= Extension_22_006C(A$(X),"{",",")
  548. T$= Extension_22_006C(T$,Chr$(228),"{")
  549. T$= Extension_22_006C(T$,Chr$(246),"|")
  550. T$= Extension_22_006C(T$,Chr$(252),"}")
  551. T$= Extension_22_006C(T$,Chr$(223),"~")
  552. T$= Extension_22_006C(T$,Chr$(196),"[")
  553. T$= Extension_22_006C(T$,Chr$(214),"\")
  554. T$= Extension_22_006C(T$,Chr$(220),"]")
  555. Print #4,T$;
  556. Return 
  557. LOESCHEN:
  558. Dec MX
  559. For X=NR To MX+1
  560.    S$(X)=S$(X+1)
  561. Next X
  562. Return 
  563. AENDERN:
  564. Gosub MAKEFELDER
  565. AWRONGAE:
  566. Cls 1 : Locate 1,5
  567. For X=1 To AF
  568.    AFAEFALSCH:
  569.    Locate 1,5+X*2 : Print N$(X)+Space$(FELEN-Len(N$(X)))+": "; : Gosub SDRU : Print Space$(FELEN+3)+""; : INVERS[MXLEN(X)] : Inverse On : IN$= Extension_22_024E("",MXLEN(X)) : Inverse Off 
  570.    A2$(X)= Extension_22_00D6(IN$)
  571.    If A2$(X)="" Then A2$(X)=A$(X) : Locate 0,Y Curs-1 : Print Space$(FELEN+3); : Inverse On : Gosub SDRU : Inverse Off 
  572. Next X
  573. Gosub DSLEN
  574. REQUESTER["Eingabe korrekt?","Ja","Nein"]
  575. If Param=2 Then Goto AWRONGAE
  576. For X=1 To AF
  577.    A$(X)=A2$(X) : A2$(X)=""
  578. Next X
  579. Gosub MAKESTRING
  580. Goto SH
  581. SDRU:
  582. T$=A$(X)
  583. T$= Extension_22_006C(T$,"{",",")
  584. Print T$
  585. Return 
  586. DUPLIZIEREN:
  587. If MX=>LAST Then Return 
  588. Inc MX
  589. S$(MX)=S$(NR)
  590. Locate Screen Width/8-Len(NR$)-Len(MX$)-6,1 : Print "Nr.:"+NR$+"/"+MX$
  591. Return 
  592. DA:
  593. If S$(1)=Chr$(255) Then Goto ERSTEMASKE
  594. REQUESTER["Datei im Speicher l�schen?","Ja","Nein"]
  595. If Param=2 Then Goto MAE
  596. ERSTEMASKE:
  597. Cls 1 : Locate 1,2 : Under On : Centre "Datei-Aufbau" : Under Off 
  598. Gosub CLEAR
  599. MX=0
  600. Locate 10,5 : Input "Datei-Name: ";DN$
  601. Curs Off : Locate 10,7 : Print "Anzahl der Felder (2-9) "; : AF$=Chr$( Extension_22_01C4("23456789")) : AF=Val(AF$)
  602. Print AF$ : Print 
  603. For X=1 To AF
  604.    Print "Feld-Nr.";X;":"; : Input N$(X)
  605.    If N$(X)="" Then N$(X)="Feld"+Str$(X)
  606. Next X
  607. FELEN=0
  608. For X=1 To AF
  609.    FELEN=Max(Len(N$(X)),FELEN)
  610.    MXLEN(X)=(Screen Width/8)-3-FELEN
  611. Next X
  612. If DN$="" Then DN$="Datei-Seq"
  613. REQUESTER["Maske korrekt?","Ja","Nein"]
  614. If Param=2 Then Goto DA
  615. Goto MA
  616. MAE:
  617. If S$(1)=Chr$(255) Then Goto DA
  618. Cls 1 : Locate 1,2 : Under On : Centre "Maske ï¿½ndern" : Under Off 
  619. Locate 5,4 : Print "Alter Datei-Name: "+DN$+"   ";
  620. Input "Neuer Datei-Name: ";NN$ : If NN$<>"" Then DN$=NN$
  621. Print 
  622. For X=1 To AF
  623.    Print "Feld-Nr.";X;": ";N$(X);Space$(FELEN-Len(N$(X)));"   ";
  624.    Input "Neuer Name: ";NN$ : If NN$<>"" Then N$(X)=NN$
  625. Next X
  626. FELEN=0
  627. For X=1 To AF
  628.    FELEN=Max(Len(N$(X)),FELEN)
  629. Next X
  630. DEL:
  631. Print 
  632. If AF=2 Then Goto INST
  633. Print "Soll ein Feld gel�scht werden? (J/N) "; : Z$=Chr$( Extension_22_01C4("JN"))
  634. Print Z$
  635. If Z$="N" Then Goto INST
  636. Input "Welche Feldnummer? ";NN
  637. If NN=0 or NN>AF Then Goto INST
  638. For NR=1 To MX
  639.    Gosub MAKEFELDER
  640.    If NN=AF Then Goto DEL2
  641.    For X=NN+1 To AF
  642.       A$(X-1)=A$(X)
  643.       MXLEN(X-1)=MXLEN(X)
  644.       PRAB(X-1)=PRAB(X)
  645.       PRLEN(X-1)=PRLEN(X)
  646.    Next X
  647.    DEL2:
  648.    Dec AF
  649.    Gosub MAKESTRING
  650.    Inc AF
  651. Next NR
  652. If NN=AF Then Dec AF : Goto DEL
  653. For X=NN+1 To AF
  654.    N$(X-1)=N$(X)
  655.    PRAB(X-1)=PRAB(X)
  656.    PRLEN(X-1)=PRLEN(X)
  657. Next X
  658. Dec AF
  659. FELEN=0
  660. For X=1 To AF
  661.    FELEN=Max(Len(N$(X)),FELEN)
  662. Next X
  663. Goto DEL
  664. INST:
  665. If AF=9 Then Goto NEUSORT
  666. Print "Soll ein Feld hinzugef�gt werden? (J/N) ";
  667. Z$=Chr$( Extension_22_01C4("JN")) : Print Z$
  668. If Z$="N" Then Goto NEUSORT
  669. Inc AF
  670. Input "Name des neuen Feldes: ";N$(AF)
  671. If N$(AF)="" Then N$(AF)="Feld"+Str$(AF)
  672. For NR=1 To MX
  673.    S$(NR)=S$(NR)+" |"
  674. Next NR
  675. PRAB(AF-1)=2 : PRAB(AF)=0 : PRLEN(AF)=Len(N$(AF)) : MXLEN(AF)=PRLEN(AF)
  676. FELEN=0
  677. For X=1 To AF
  678.    FELEN=Max(Len(N$(X)),FELEN)
  679. Next X
  680. Goto INST
  681. NEUSORT:
  682. Print : Print "Soll die Reihenfolge der Felder ge�ndert werden? (J/N) ";
  683. Z$=Chr$( Extension_22_01C4("JN")) : Print Z$
  684. If Z$="N" Then Goto FRAGE
  685. WW$=""
  686. For X=1 To AF
  687.    WW$=WW$+Str$(X)
  688. Next X
  689. For X=1 To AF
  690.    Print "Alte Feld-Nr.:";X;"   Neue Feld-Nummer ";
  691.    Z$=Chr$( Extension_22_01C4(WW$)) : NEU(X)=Val(Z$) : Print Z$
  692. Next X
  693. For NR=1 To MX
  694.    Gosub MAKEFELDER
  695.    For X=1 To AF
  696.       For Y=1 To AF
  697.          If NEU(X)=Y Then B$(Y)=A$(X)
  698.       Next Y
  699.    Next X
  700.    For X=1 To AF
  701.       A$(X)=B$(X) : B$(X)=""
  702.    Next X
  703.    Gosub MAKESTRING
  704. Next NR
  705. FELDNAMEORDNEN:
  706. For X=1 To AF
  707.    For Y=1 To AF
  708.       If NEU(X)=Y Then NB$(Y)=N$(X) : PRLEN2(Y)=PRLEN(X) : PRAB2(Y)=PRAB(X) : MXLEN2(Y)=MXLEN(X)
  709.    Next Y
  710. Next X
  711. For X=1 To AF
  712.    N$(X)=NB$(X) : PRLEN(X)=PRLEN2(X) : PRAB(X)=PRAB2(X) : MXLEN(X)=MXLEN2(X)
  713. Next X
  714. For X=1 To AF-1
  715.    If PRAB(X)=0 Then PRAB(X)=2
  716. Next X
  717. PRAB(AF)=0
  718. FRAGE:
  719. REQUESTER["Ist die neue Maske korrekt?","Ja","Nein"]
  720. If Param=2 Then Goto MAE
  721. Goto MA
  722. EG:
  723. Cls 1 : NR=0 : If AF=0 Then MELDUNG["Masken-Aufbau fehlt!"] : Goto MA
  724. EINNEXT:
  725. Cls 1 : If NR>LAST Then Goto DATEIVOLL
  726. AUTOSAVE
  727. BF1=(100*(MX*100))/LAST : BF1=10000-BF1 : BF$=Str$(BF1) : BF$=Left$(BF$,Len(BF$)-2)+"."+Right$(BF$,2)
  728. Locate 1,2 : Print "Speicherkapazit�t:";BF$;"% frei  -  ";"Freier Arbeitsspeicher:";Free;" Bytes"
  729. If DI=1 Then NR=MX+2 : Print " Satz-Nr.";E : X=1 : Goto EGL
  730. NR=MX+1 : Print " Satz-Nr.";NR : X=1
  731. EGL:
  732. If X<=AF Then Print : Print " "+N$(X)+Space$(FELEN-Len(N$(X)))+": "; : INVERS[MXLEN(X)] : Clear Key : Inverse On : IN$= Extension_22_024E("",MXLEN(X)) : If IN$="" Then IN$=" "
  733. Gosub SPECIAL : IN$= Extension_22_00D6(IN$) : A$(X)=IN$ : Inverse Off 
  734. If REP$(1)=" " Then If A$(1)=Chr$(9) Then A$(1)=" "
  735. If A$(1)=" " Then Goto MA
  736. If A$(X)=Chr$(9) Then A$(X)=REP$(X) : Inverse On : Print A$(X) : Inverse Off 
  737. REP$(X)=A$(X)
  738. If X<AF Then Inc X : Goto EGL
  739. Gosub DSLEN
  740. Gosub MAKESTRING : If DI Then Return 
  741. Inc MX
  742. REQUESTER["Weitere Eingaben?","Ja","Nein"]
  743. If Param=1 Then Inc NR : Goto EINNEXT
  744. Goto MA
  745. SPECIAL:
  746. IN$= Extension_22_006C(IN$,",","{")
  747. Return 
  748. DATEIVOLL:
  749. MELDUNG["Datei ist voll!"]
  750. Goto MA
  751. DSLEN:
  752. For X=1 To AF
  753.    MXLEN(X)=Max(Len(A$(X))+1,MXLEN(X))
  754.    MXLEN(X)=Max(MXLEN(X),Len(N$(X)))
  755. Next X
  756. Return 
  757. ZSPEC:
  758. If Z<5001 Then Return 
  759. If Z=5072 Then Gosub HCOP
  760. If Z=5076 Then Gosub LOESCHEN : Return 
  761. If Z=5196 Then Gosub AENDERN
  762. If Z=5068 Then Gosub DUPLIZIEREN
  763. GC[1] : Z=Param
  764. Return 
  765. AEN:
  766. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  767. Cls 1 : Locate 1,3 : Under On : Centre "Daten-Satz ï¿½ndern" : Under Off 
  768. AUTOSAVE
  769. Locate 17,5 : Input "Satz-Nummer: ";Z
  770. If Extension_22_0080(Z,1,MX)=0 Then Goto MA
  771. NR=Z
  772. Gosub AENDERN : Goto MA
  773. ID:
  774. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  775. Cls 1
  776. AUTOSAVE
  777. Restore DID : Gosub RD
  778. On IN Goto DASADEL,DASAINST,DABEDEL,MA
  779. DASADEL:
  780. Cls 1 : Locate 6,5 : Input "Nummer des zu l�schenden Satzes: ";L
  781. If Extension_22_0080(L,1,MX)=0 Then Goto MA
  782. SATZDEL:
  783. NR=L : Gosub SH
  784. REQUESTER["Datensatz korrekt?","Ja","Nein"]
  785. If Param=2 Then Goto DASADEL
  786. Dec MX
  787. For X=NR To MX+1
  788.    S$(X)=S$(X+1)
  789. Next X
  790. Goto REID
  791. DASAINST:
  792. Cls 1 : Locate 5,5 : Input "Nummer vor der eingef�gt werden soll: ";E : Print : Print 
  793. If Extension_22_0080(E,1,MX)=0 Then Goto MA
  794. WORKING
  795. NR=E : DI=1 : Gosub EINNEXT : DI=0
  796. For NR=MX To E Step -1
  797.    S$(NR+1)=S$(NR)
  798. Next NR
  799. S$(E)=S$(MX+2)
  800. S$(MX+2)=Chr$(255) : Inc MX
  801. WORKOFF
  802. Goto REID
  803. DABEDEL:
  804. Cls 1 : Locate 5,5 : Input "Welcher Bereich soll gel�scht werden: ";LB$
  805. If LB$="" Then Goto MA
  806. If LB$="0" Then Goto MA
  807. WORKING
  808. LB=Instr(LB$,"-")
  809. If LB=0 Then L=Val(LB$) : Goto SATZDEL
  810. If LB=1 Then Goto DELBIS
  811. If LB=Len(LB$) Then Goto DELAB
  812. Goto DELVB
  813. DELBIS:
  814. LB$=Mid$(LB$,2) : NR=Val(LB$)+1
  815. LR=1
  816. For X=NR To MX
  817.    S$(LR)=S$(X) : Inc LR
  818. Next X
  819. MX=MX-Val(LB$)
  820. For X=1 To Val(LB$)
  821.    S$(MX+X)=Chr$(255)
  822. Next X
  823. WORKOFF
  824. Goto REID
  825. DELAB:
  826. LB=Val(Mid$(LB$,1,Len(LB$)-1))
  827. For X=LB To MX
  828.    S$(X)=Chr$(255)
  829. Next X
  830. MX=LB-1
  831. WORKOFF
  832. Goto REID
  833. DELVB:
  834. K1=Val(Mid$(LB$,1,Instr(LB$,"-")-1)) : X=Val(Mid$(LB$,Instr(LB$,"-")+1)) : MX2=X-K1+1 : MX=MX-MX2
  835. For Y=K1 To X
  836.    S$(Y)=Chr$(255)
  837. Next Y
  838. Inc X
  839. While S$(X)<>Chr$(255)
  840. S$(K1)=S$(X) : Inc X : Inc K1
  841. Wend 
  842. WORKOFF
  843. REID:
  844. Gosub RY : Goto ID
  845. DRU:
  846. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  847. PT= Extension_22_06FE 
  848. If PT=252 Then Goto DRUCKEROK
  849. Cls 1
  850. If PT=248 Then REQUESTER["FEHLER - Drucker ist >OFFLINE<","Fehler behoben","Abbruch"]
  851. If PT=255 Then REQUESTER["FEHLER - Drucker ist nicht erreichbar","Fehler behoben","Abbruch"]
  852. If Param=2 Then Goto MA
  853. Goto DRU
  854. DRUCKEROK:
  855. Cls 1
  856. AUTOSAVE
  857. PREF:
  858. If PRLEN(1)=0
  859.    SN=0
  860.    For X=1 To AF
  861.       PRLEN(X)=MXLEN(X)
  862.       PRAB(X)=2
  863.    Next X
  864.    PRAB(AF)=0
  865.    GESLEN=0
  866.    For X=1 To AF
  867.       GESLEN=GESLEN+MXLEN(X)+PRAB(X)
  868.    Next X
  869. End If 
  870. If PRLEN(1)=0 and GESLEN<41 Then BR=0
  871. If PRLEN(1)=0 and GESLEN>40 and GESLEN<81 Then BR=1
  872. If PRLEN(1)=0 and GESLEN>80 and GESLEN<137 Then BR=2
  873. If PRLEN(1)=0 and GESLEN>136 Then MELDUNG["Achtung !!!"+Chr$(10)+"Bitte Drucker-Preferences einstellen!"] : BR=3
  874. If KLARO=1 Then KLARO=0 : Return 
  875. Gosub INIT
  876. Show : Restore DM : Gosub RD : Cls 1 : Locate 5,5
  877. On IN Goto ALLEDRU,DABEDRU,KRIDRU,DRUPREF,MA
  878. DRUPREF:
  879. GESLEN=0
  880. For X=1 To AF
  881.    GESLEN=GESLEN+PRLEN(X)+PRAB(X)
  882. Next X
  883. If SN=1 Then GESLEN=GESLEN+7
  884. PO$(1)="Satz-Nummer:" : PO$(2)="Druckbreite:"
  885. For X=1 To AF
  886.    PO$(X+2)=N$(X)+Space$(FELEN-Len(N$(X)))
  887. Next X
  888. PREFS:
  889. Hide : Curs Off : Cls 1
  890. PO=1 : PP=0
  891. PRELOP:
  892. Locate 0,5
  893. Print " Satz-Nummer:"
  894. Print 
  895. Print " Druckbreite:"
  896. Print 
  897. Print " Feld";Space$(FELEN-4);"   Feldbreite    Feldabstand    max. Feldbreite"
  898. Print 
  899. For X=1 To AF
  900.    Print " ";N$(X);Space$(FELEN-Len(N$(X)));"       "; Using "###";PRLEN(X);"            "; Using "###";PRAB(X);"             "; Using "###";MXLEN(X)
  901. Next X
  902. Print : Print " Gesamtbreite:"; Using "###";GESLEN
  903. Print : Print " ESC = Einstellungen ok"
  904. Y1=(AF+5)*8+65
  905. X1=(FELEN+49)*8
  906. Box 1,70 To X1,Y1
  907. Box 1,82 To X1,Y1-12
  908. Polyline(FELEN+2)*8,70 To(FELEN+2)*8,Y1-12
  909. Polyline(FELEN+16)*8,70 To(FELEN+16)*8,Y1-12
  910. Polyline(FELEN+31)*8,70 To(FELEN+31)*8,Y1-12
  911. Gosub INV2
  912. Goto SHPR
  913. GLO:
  914. Z$=Inkey$ : If Z$="" Then Goto GLO
  915. Z=Asc(Z$) : If Z=27 Then Goto DRU
  916. LOP2:
  917. If Extension_22_0080(Z,28,31)=0 Then Goto GLO
  918. If Z=30 or Z=31 Then Gosub INV
  919. If Z=31 Then Inc PO : If PO>AF+2 Then PO=1
  920. If Z=30 Then Dec PO : If PO<1 Then PO=AF+2
  921. If Z=30 or Z=31 Then Gosub INV2
  922. If PO=1 Then If Z=28 Then Inc SN : If SN=2 Then SN=0
  923. If PO=1 Then If Z=29 Then Dec SN : If SN<0 Then SN=1
  924. If PO=2 Then If Z=28 Then Inc BR : If BR=3 Then BR=0
  925. If PO=2 Then If Z=29 Then Dec BR : If BR<0 Then BR=2
  926. If PO<3 Then Goto SHPR
  927. If PO=AF+2 Then PP=0
  928. If PP=0 Then Locate FELEN+7,PO+8 : Print ">" : Locate FELEN+23,PO+8 : Print " " : Goto FELDER
  929. If PP=1 Then Locate FELEN+7,PO+8 : Print " " : Locate FELEN+23,PO+8 : Print ">" : Goto FELDER
  930. INV:
  931. If PO=1 Then Y=5
  932. If PO=2 Then Y=7
  933. If PO>2 Then Y=PO+8
  934. Locate 1,Y : Inverse Off : Print PO$(PO) : Return 
  935. INV2:
  936. If PO=1 Then Y=5
  937. If PO=2 Then Y=7
  938. If PO>2 Then Y=PO+8
  939. Locate 1,Y : Inverse On : Print PO$(PO) : Inverse Off : Return 
  940. SHPR:
  941. If SN=0 Then Locate 14,5 : Inverse On : Print "OFF"; : Inverse Off : Print "  ON"
  942. If SN=1 Then Locate 14,5 : Inverse Off : Print "OFF  "; : Inverse On : Print "ON"
  943. If BR=0 Then Locate 14,7 : Inverse On : Print "40"; : Inverse Off : Print "  80  160 cpl"
  944. If BR=1 Then Locate 14,7 : Inverse Off : Print "40  "; : Inverse On : Print "80"; : Inverse Off : Print "  160 cpl"
  945. If BR=2 Then Locate 14,7 : Inverse Off : Print "40  80  "; : Inverse On : Print "160"; : Inverse Off : Print " cpl"
  946. Gosub ML : Goto GLO
  947. FELDER:
  948. Z$=Inkey$ : If Z$="" Then Goto FELDER
  949. Z=Asc(Z$) : If Z=27 Then Goto DRU
  950. If Z=30 or Z=31 Then Locate FELEN+7,PO+8 : Print " " : Locate FELEN+23,PO+8 : Print " " : Goto LOP2
  951. FELDER2:
  952. If Z=28 Then Inc PP : If PP>1 Then PP=0
  953. If Z=29 Then Dec PP : If PP<0 Then PP=1
  954. If PO=AF+2 and PP=1 Then PP=0 : Goto FELDER
  955. If Z=28 and PP=0 Then Locate FELEN+7,PO+8 : Print ">" : Locate FELEN+23,PO+8 : Print " " : Goto FELDER
  956. If Z=28 and PP=1 Then Locate FELEN+7,PO+8 : Print " " : Locate FELEN+23,PO+8 : Print ">" : Goto FELDER
  957. If Z=29 and PP=0 Then Locate FELEN+7,PO+8 : Print ">" : Locate FELEN+23,PO+8 : Print " " : Goto FELDER
  958. If Z=29 and PP=1 Then Locate FELEN+7,PO+8 : Print " " : Locate FELEN+23,PO+8 : Print ">" : Goto FELDER
  959. If Extension_22_0080(Z,48,57)=0 Then Goto FELDER
  960. TEST:
  961. If PP=1 Then Goto TEST1
  962. Locate FELEN+8,PO+8 : ZZ= Extension_22_01D6(Z,2)
  963. ZZ=Max(ZZ,MXLEN(PO-2))
  964. PRLEN(PO-2)=ZZ
  965. Locate FELEN+8,Y Curs : Print Using "###";PRLEN(PO-2)
  966. Gosub ML
  967. Locate FELEN+7,PO+8 : Print ">" : Goto FELDER
  968. TEST1:
  969. If PO=AF+2 Then Z=28 : Goto FELDER2
  970. Locate FELEN+24,PO+8 : ZZ= Extension_22_01D6(Z,1)
  971. If ZZ=0 Then ZZ=1
  972. PRAB(PO-2)=ZZ
  973. Locate FELEN+24,Y Curs : Print PRAB(PO-2)
  974. Gosub ML
  975. Locate FELEN+23,PO+8 : Print ">" : Goto FELDER
  976. ML:
  977. GESLEN=0
  978. For X=1 To AF
  979.    GESLEN=GESLEN+PRLEN(X)+PRAB(X)
  980. Next X
  981. If SN=1 Then GESLEN=GESLEN+7
  982. Locate 14,AF+12 : Print Using "###";GESLEN
  983. Return 
  984. ALLEDRU:
  985. NR=0
  986. Gosub PARTITEL
  987. ZEILE=4
  988. ALLEDRUNE:
  989. Inc NR : Inc ZEILE
  990. POSITION[NR]
  991. If S$(NR)=Chr$(255) Then Goto ALLEDRUEN
  992. If ZEILE=LINES Then Print #4,Chr$(12) : Print #4,TITEL$; : Print #4,""
  993. If ZEILE=LINES and SN=1 Then Print #4," Nr.: ";
  994. If ZEILE=LINES Then For X=1 To AF-1 : DRUGERMAN[N$(X),PRLEN(X),PRAB(X)] : Next X
  995. If ZEILE=LINES Then DRUGERMAN[N$(AF),PRLEN(AF),0]
  996. If ZEILE=LINES Then Print #4,NORM$ : ZEILE=4
  997. Gosub MAKEFELDER
  998. Gosub AUSDRUCK
  999. Print #4,"" : Goto ALLEDRUNE
  1000. ALLEDRUEN:
  1001. Print #4,TITEL$
  1002. PA2$="Anzahl der Datens�tze:"+Str$(NR-1)
  1003. DRUGERMAN[PA2$,Len(PA2$),0]
  1004. Print #4,INIT$
  1005. Print #4,BEL$
  1006. Close 4
  1007. Goto REDRU
  1008. DABEDRU:
  1009. Locate 0,Y Curs : Input "Welcher Bereich soll ausgedruckt werden? ";BB$
  1010. If BB$="" Then Goto DRUCKEROK
  1011. Gosub BEREICH
  1012. Print : Print "Satz Nummer: "; : CX=X Curs : CY=Y Curs
  1013. If B1=0 Then Goto DRUCKEROK
  1014. Gosub PARTITEL
  1015. For NR=B1 To B2
  1016.    POSITION[NR]
  1017.    Gosub MAKEFELDER
  1018.    Gosub AUSDRUCK
  1019.    Print #4,""
  1020. Next NR
  1021. Print #4,TITEL$
  1022. PA2$="Anzahl der Datens�tze:"+Str$(B2-B1+1)
  1023. DRUGERMAN[PA2$,Len(PA2$),0]
  1024. Print #4,INIT$
  1025. Print #4,BEL$
  1026. Close 4
  1027. Goto REDRU
  1028. KRIDRU:
  1029. KX$="" : Locate 0,Y Curs
  1030. For X=1 To AF
  1031.    Print X;" ";N$(X)
  1032.    KX$=KX$+Str$(X)
  1033. Next X
  1034. Print : Print "Welcher Begriff? "
  1035. DB$=Chr$( Extension_22_01C4(KX$)) : Print DB$
  1036. DB=Val(DB$)
  1037. Cls 1
  1038. Print N$(DB);": "; : IN$= Extension_22_024E("",60)
  1039. NR=0
  1040. Gosub PARTITEL
  1041. DRUNE:
  1042. Inc NR
  1043. POSITION[NR]
  1044. If S$(NR)=Chr$(255) Then Print #4,"" : Print #4,INIT$ : Print #4,BEL$ : Close 4 : Goto REDRU
  1045. Gosub MAKEFELDER
  1046. IN= Extension_22_0006(Upper$(A$(DB)),Upper$(IN$))
  1047. If IN=0 Then Goto DRUNE
  1048. Gosub AUSDRUCK : Print #4,"" : Goto DRUNE
  1049. REDRU:
  1050. Gosub RY : Goto DRUCKEROK
  1051. AUSDRUCK:
  1052. If SN=1 Then Print #4, Using "####";NR; : Print #4,": ";
  1053. For X=1 To AF-1
  1054.    DRUGERMAN[A$(X),PRLEN(X),PRAB(X)]
  1055. Next X
  1056. DRUGERMAN[A$(AF),PRLEN(AF),0]
  1057. Return 
  1058. INIT:
  1059. INIT$=Chr$(27)+"c"
  1060. BEL$=Chr$(8)
  1061. GERMAN$=Chr$(27)+"(K"
  1062. UNDERLINE$=Chr$(27)+"[4m"
  1063. BOLD$=Chr$(27)+"[1m"
  1064. FINE$=Chr$(27)+"[4w"
  1065. ACHTEL$=Chr$(27)+"[0z"
  1066. WIDE$=Chr$(27)+"[6w"
  1067. NORM$=Chr$(27)+"[24m"+Chr$(27)+"[22m"+Chr$(27)+"[0w"
  1068. LINES=58
  1069. If BR=2 Then PREF$=FINE$+ACHTEL$ : LINES=87
  1070. If BR=1 Then PREF$=NORM$
  1071. If BR=0 Then PREF$=WIDE$
  1072. INITSTRING$=INIT$+GERMAN$+PREF$
  1073. TITEL$=UNDERLINE$+BOLD$
  1074. Open Out 4,"PRT:"
  1075. Print #4,INITSTRING$
  1076. Close 4
  1077. Return 
  1078. PARTITEL:
  1079. Open Out 4,"PRT:"
  1080. Print #4,TITEL$;
  1081. Print #4,DN$
  1082. Print #4,""
  1083. Print #4,"Stand: ";
  1084. If AKT=1 Then Print #4,TMJ$
  1085. If AKT=0 Then Print #4,TMJ2$
  1086. Print #4,""
  1087. If SN=1 Then Print #4," Nr.: ";
  1088. For X=1 To AF-1
  1089.    DRUGERMAN[N$(X),PRLEN(X),PRAB(X)]
  1090. Next X
  1091. DRUGERMAN[N$(AF),PRLEN(AF),0]
  1092. Print #4,NORM$
  1093. Return 
  1094. FL:
  1095. Cls 1 : AUTOSAVE : Curs Off : On Error Goto FLFEHL
  1096. Restore DF : Gosub RD
  1097. Cls 1
  1098. On IN Goto RENA,DELFILE,DI,MA
  1099. FLFEHL:
  1100. Resume Next 
  1101. DI:
  1102. Locate 10,2 : Show : Clear Key : LD$=Fsel$("","","Inhalt","") : Hide : Goto FL
  1103. RENA:
  1104. Show : Clear Key : OAM$=Fsel$("","","Alter Name","") : Hide 
  1105. Locate 5,5 : Print "Alter Name: ";OAM$
  1106. Locate 5,7 : Input "Neuer Name: ";NNAM$
  1107. If NNAM$="" Then Goto FL
  1108. If NNAM$=OAM$ Then Goto FL
  1109. Rename OAM$ To NNAM$ : Goto FL
  1110. DELFILE:
  1111. Show : Clear Key : LD$=Fsel$("","","Datei","l�schen") : Hide 
  1112. If LD$="" Then Goto FL
  1113. REQUESTER[LD$+" wirklich l�schen?","Ja","Nein"]
  1114. If Param=1 Then Kill LD$
  1115. Goto FL
  1116. SO:
  1117. If S$(1)=Chr$(255) Then Goto KEINEDATEN
  1118. Cls 1 : Locate 1,2 : Under On : Centre "Sortieren" : Print : Print : Under Off 
  1119. AUTOSAVE
  1120. Centre " Nach welchem Kriterium soll sortiert werden?"
  1121. For X=1 To AF
  1122.    ME$(X)=N$(X) : SX$(X)=SX$(X)+Str$(X)
  1123. Next X
  1124. ME$(AF+1)="Abbruch" : ME$(0)=""
  1125. ANZ=AF+1
  1126. MYMEN[ANZ]
  1127. Wait 5
  1128. SZ=Param
  1129. If SZ=ANZ Then Goto MA
  1130. SOV=SOF
  1131. SOF=SZ
  1132. REQUESTER["Sortiervorgang","aufsteigend","absteigend"]
  1133. WORKING
  1134. Show : Change Mouse 3 : AUF=Param : If AUF=2 Then SOF=SOF*(-1)
  1135. If SOF=SOV Then Goto SOVEND
  1136. If SZ=1 Then Goto SONORM
  1137. For L=1 To MX
  1138.    NR=L : Gosub MAKEFELDER : S$(L)=A$(SZ)+"|"
  1139.    For Q=1 To AF
  1140.       If Q<>SZ Then S$(L)=S$(L)+A$(Q)+"|"
  1141.    Next Q
  1142. Next L
  1143. SONORM:
  1144. Gosub SCRYPT : Gosub SOR : Gosub SENCRYPT
  1145. If SZ<>1 Then Gosub ALTEREIHE
  1146. SOVEND:
  1147. SOTE=1 : Gosub UP : SOTE=0
  1148. Change Mouse 1 : Hide : WORKOFF : Goto RM
  1149. ALTEREIHE:
  1150. For I=1 To MX
  1151.    NR=I : A$(SZ)=Left$(S$(I),Instr(S$(I),"|")-1)
  1152.    M$=Right$(S$(I),Len(S$(I))-Instr(S$(I),"|")) : S$(I)=M$ : If SZ<2 Then Goto ALTEREIHE2
  1153.    For Y=1 To SZ-1
  1154.       A$(Y)=Left$(S$(I),Instr(S$(I),"|")-1)
  1155.       M$=Right$(S$(I),Len(S$(I))-Instr(S$(I),"|")) : S$(I)=M$
  1156.    Next Y
  1157.    If SZ=AF Then Goto ALTEREIHE3
  1158.    ALTEREIHE2:
  1159.    If SZ=AF Then Goto ALTEREIHE3
  1160.    For Y=SZ+1 To AF
  1161.       A$(Y)=Left$(S$(I),Instr(S$(I),"|")-1)
  1162.       M$=Right$(S$(I),Len(S$(I))-Instr(S$(I),"|")) : S$(I)=M$
  1163.    Next Y
  1164.    ALTEREIHE3:
  1165.    Gosub MAKESTRING
  1166. Next I
  1167. Return 
  1168. SOR:
  1169. Sort S$(MX)
  1170. If AUF=1 Then Return 
  1171. For X=1 To MX/2
  1172.    Swap S$(MX-X+1),S$(X)
  1173. Next X
  1174. Return 
  1175. LCOUNT:
  1176. LCY$="0123456789 A�BCDEFGHIJKLMNO�PQRSTU�VWXYZ&!@#$%*()+-='<>?,.:;/"
  1177. For LC=1 To Len(LCY$)
  1178.    SB(LC)=0
  1179. Next LC
  1180. For NR=1 To MX
  1181.    Gosub MAKEFELDER
  1182.    LCZ=Instr(LCY$,Upper$(Left$(A$(SOF),1))) : If LCZ>0 Then SB(LCZ)=SB(LCZ)+1
  1183. Next NR
  1184. LCY$=""
  1185. Return 
  1186. IM:
  1187. Show 
  1188. Cls 1 : Home : Print : Centre "GoAmiga!-Datei.DAT zu JD-Datei.seq konvertieren."
  1189. Print : Centre "Es werden 5 Phasen ben�tigt!"
  1190. REQUESTER["GoAmiga!-Datei importieren?","Ja","Nein"]
  1191. If Param=2 Then Goto MA
  1192. Clear Key : DD$=Fsel$("*.DAT","","GoAmiga!-Datei","konvertieren")
  1193. If DD$="" Then Goto MA
  1194. On Error Goto KONV_FEHLER
  1195. Hide 
  1196. SOURCE$=DD$
  1197. DEST$=DD$+".conv"
  1198. Print : Print : Print "Phase 1"
  1199. FILE_COPY[SOURCE$,DEST$]
  1200. Print "Phase 2"
  1201. Open In 8,DD$+".conv"
  1202. For X=1 To MX
  1203.    Input #8,S$(X)
  1204. Next X
  1205. Close 
  1206. For X=1 To AF
  1207.    N$(X)="Feld"+Str$(X)
  1208. Next X
  1209. Print "Phase 3"
  1210. FELEN=0
  1211. For ZZX=1 To AF
  1212.    FELEN=Max(FELEN,Len(N$(ZZX)))
  1213.    MXLEN(ZZX)=0 : PRLEN(ZZX)=0
  1214. Next ZZX
  1215. Print "Phase 4"
  1216. For NR=1 To MX
  1217.    Gosub MAKEFELDER
  1218.    For ZZX=1 To AF
  1219.       A=Len(A$(ZZX)) : MXLEN(ZZX)=Max(MXLEN(ZZX),A)
  1220.    Next ZZX
  1221. Next NR
  1222. Print "Phase 5"
  1223. For ZZX=1 To AF
  1224.    PRLEN(ZZX)=Max(PRLEN(ZZX),MXLEN(ZZX))
  1225.    PRLEN(ZZX)=Max(Len(N$(ZZX)),PRLEN(ZZX))
  1226. Next ZZX
  1227. Gosub LCOUNT
  1228. Cls 1 : Locate 0,1 : Centre "GoAmiga!-Datei ist konvertiert!"
  1229. Locate 0,3 : Centre "Anzahl der Datens�tze:"+Str$(MX)
  1230. Locate 0,5 : Centre "Freier Speicher:"+Str$(Free)+" Bytes"
  1231. REQUESTER["Sequenz abspeichern?","Ja","Nein"]
  1232. If Param=2 Then Goto MA
  1233. JD$=Left$(DD$,Len(DD$)-4)+".seq"
  1234. Open Out 8,JD$
  1235. Print #8,"JD-Datei-Sequenz"
  1236. Print #8,TMJ$
  1237. Print #8,SOF
  1238. Print #8,AF
  1239. Print #8,0
  1240. Print #8,0
  1241. For X=1 To AF
  1242.    Print #8,PRLEN(X)
  1243.    Print #8,PRAB(X)
  1244. Next X
  1245. Print #8,FELEN
  1246. For X=1 To AF
  1247.    Print #8,N$(X)
  1248.    Print #8,MXLEN(X)
  1249. Next X
  1250. DN$=Left$(DD$,Len(DD$)-4)
  1251. Print #8,DN$
  1252. Print #8,MX
  1253. For NR=1 To 61
  1254.    Print #8,SB(NR)
  1255. Next NR
  1256. For X=1 To MX
  1257.    Print #8,S$(X)
  1258. Next X
  1259. Close 8
  1260. Kill DD$+".conv"
  1261. Goto MA
  1262. SCRYPT:
  1263. For I=1 To MX
  1264.    S$(I)= Extension_22_00F8(S$(I))
  1265. Next I
  1266. Return 
  1267. SENCRYPT:
  1268. For I=1 To MX
  1269.    S$(I)= Extension_22_0108(S$(I))
  1270. Next I
  1271. Return 
  1272. SH:
  1273. Cls 1,0,0 To 680,219 : Change Mouse 1
  1274. Locate 1,1 : Centre DN$ : Locate 0,3
  1275. Gosub MAKEFELDER
  1276. For TX=1 To AF
  1277.    Print N$(TX)+Space$(FELEN-Len(N$(TX)))+": ";
  1278.    For X=1 To Len(A$(TX))
  1279.       T$=Mid$(A$(TX),X,1)
  1280.       If T$="{" Then T$=","
  1281.       Print T$;
  1282.    Next 
  1283.    Print 
  1284. Next TX
  1285. NR$=Str$(NR)
  1286. MX$=Str$(MX)-" "
  1287. Locate 1,1
  1288. If AKT=1 Then Print TMJ$
  1289. If AKT=0 Then Print TMJ2$
  1290. Locate Screen Width/8-Len(NR$)-Len(MX$)-6,1 : Print "Nr.:"+NR$+"/"+MX$
  1291. Return 
  1292. MAKESTRING:
  1293. I=NR : If A$(1)=" " Then Return 
  1294. S$(I)=""
  1295. For X=1 To AF
  1296.    S$(I)=S$(I)+A$(X)+"|"
  1297. Next X
  1298. Return 
  1299. MAKEFELDER:
  1300. I=NR : If S$(I)=Chr$(255) Then Return 
  1301. C$=S$(I)
  1302. For X=1 To AF
  1303.    A$(X)=Left$(C$,Instr(C$,"|")-1)
  1304.    C$=Right$(C$,Len(C$)-Instr(C$,"|"))
  1305. Next X
  1306. Return 
  1307. RM:
  1308. Gosub RY : Goto MA
  1309. RY:
  1310. Clear Key : Bell : Change Mouse 1
  1311. RY2:
  1312. A$=Inkey$
  1313. If Mouse Key=1 Then Return 
  1314. If A$<>"" Then Return 
  1315. Goto RY2
  1316. KEINEDATEN:
  1317. MELDUNG["Es befinden sich keine Daten im Speicher!"]
  1318. Goto MA2
  1319. SUFENICHT:
  1320. MELDUNG["Suche erfolglos abgebrochen!"]
  1321. Goto SU
  1322. CLEAR:
  1323. For X=1 To LAST
  1324.    S$(X)=Chr$(255)
  1325. Next X
  1326. For X=1 To 9
  1327.    N$(X)="" : A$(X)="" : MM$(X)="" : A2$(X)="" : B$(X)="" : NB$(X)="" : REP$(X)="" : SX$(X)=""
  1328.    NEU(X)=0 : PRLEN(X)=0 : PRAB(X)=0 : MXLEN(X)=0 : MXLEN2(X)=0 : MLEN(X)=0 : PRLEN2(X)=0 : PRAB2(X)=0
  1329. Next X
  1330. Return 
  1331. RD:
  1332. Read ME$(0)
  1333. Read ANZ
  1334. If ANZ=99 Then Goto GSU
  1335. For X=1 To ANZ
  1336.    Read ME$(X)
  1337. Next X
  1338. Goto CON
  1339. GSU:
  1340. For X=1 To 3
  1341.    Read ME$(X)
  1342. Next X
  1343. For X=1 To AF
  1344.    ME$(X+3)=N$(X)
  1345. Next X
  1346. ANZ=AF+3
  1347. CON:
  1348. MYMEN[ANZ]
  1349. IN=Param
  1350. Return 
  1351. LONG:
  1352. DILEN=Len("JD-Datei-Sequenz")+2
  1353. DILEN=DILEN+Len(TMJ2$)+2
  1354. DILEN=DILEN+Len(DN$)+2
  1355. DILEN=DILEN+Len(Str$(AF))+2
  1356. DILEN=DILEN+Len(Str$(SN))+2
  1357. DILEN=DILEN+Len(Str$(BR))+2
  1358. DILEN=DILEN+Len(Str$(FELEN))+2
  1359. DILEN=DILEN+Len(Str$(MX))+2
  1360. For X=1 To AF
  1361.    DILEN=DILEN+Len(Str$(PRLEN(X)))+2
  1362.    DILEN=DILEN+Len(Str$(PRAB(X)))+2
  1363.    DILEN=DILEN+Len(N$(X))+2
  1364.    DILEN=DILEN+Len(Str$(MXLEN(X)))+2
  1365. Next X
  1366. For X=1 To MX
  1367.    DILEN=DILEN+Len(S$(X))+2
  1368. Next X
  1369. For X=1 To 61
  1370.    DILEN=DILEN+Len(Str$(SB(X)))+2
  1371. Next 
  1372. Return 
  1373. BEREICH:
  1374.  Extension_22_0162 : Extension_22_0150(BB$)
  1375. B1= Extension_22_0190 : B2= Extension_22_01A4 
  1376. B1=Max(B1,1) : B2=Min(B2,MX)
  1377. Return 
  1378. MEM:
  1379. Data 2,"RAM DISK:","BOOTRAM:"
  1380. HM:
  1381. Data "Datei-Verwaltung",16,"Laden","Bl�ttern","Neue Maske","Eingabe","Sortieren","Drucken","Farbe","Update"
  1382. Data "Speichern","Suchen","Maske ï¿½ndern","Daten ï¿½ndern","Daten Inst/Del","Disk-Befehle","ASC-Import","Ende"
  1383. LM:
  1384. Data "",3,"Laden","Menu","Anh�ngen"
  1385. SM:
  1386. Data "",2,"�berschreiben","Neuer Name"
  1387. BM:
  1388. Data "Bl�ttern",5,"Alle","Gezielt","Bereich","Liste","Menu"
  1389. SUM:
  1390. Data "Suchen",99,"Menu","Ohne Kriterium","Mit Kriterium"
  1391. DID:
  1392. Data "Daten Inst/Del",4,"Satz l�schen","Satz einf�gen","Bereich l�schen","Menu"
  1393. DM:
  1394. Data "Drucken",5,"Alle","Bereich","Kriterium","Einstellungen","Menu"
  1395. DF:
  1396. Data "Disk-Befehle",4,"Umbenennen","L�schen","Inhalt","Menu"
  1397. Procedure SETUP
  1398.    Close Editor 
  1399.    Screen Open 0,680,257,4,Hires
  1400.    Limit Mouse 112,42 To 447,298
  1401.    Curs Off : Flash Off : Hide 
  1402.    SET_COL
  1403.    Request Off 
  1404.    TITEL
  1405.    SET_TIME
  1406. End Proc
  1407. Procedure MYMEN[ANZ]
  1408.    Shared ME$()
  1409.    Reset Zone 
  1410.    BREITE=Screen Width
  1411.    BREITE=BREITE/8
  1412.    Locate 1,3 : Under On : Centre ME$(0) : Under Off 
  1413.    BLEN=0
  1414.    For X=1 To ANZ
  1415.       ALEN=Len(ME$(X)) : BLEN=Max(BLEN,ALEN)
  1416.    Next 
  1417.    For X=1 To ANZ
  1418.       ME$(X)= Extension_22_011A(ME$(X),BLEN,0)
  1419.    Next 
  1420.    Inverse On : Show : Curs Off 
  1421.    Wait 10
  1422.    LL=2*BLEN+4
  1423.    L1=(BREITE-LL)/2
  1424.    L2=L1+4+BLEN
  1425.    P=4
  1426.    ANZ1=ANZ/2
  1427.    If ANZ/2*2<ANZ Then ANZ1=ANZ1+1
  1428.    For X=1 To ANZ1
  1429.       K$=ME$(X)
  1430.       P=P+2
  1431.       Box L1*8-1,P*8-1 To L1*8+BLEN*8,P*8+8
  1432.       Locate L1,P
  1433.       Print Zone$(K$,X)
  1434.    Next 
  1435.    P=4
  1436.    For X=ANZ1+1 To ANZ
  1437.       K$=ME$(X)
  1438.       P=P+2
  1439.       Box L2*8-1,P*8-1 To L2*8+BLEN*8,P*8+8
  1440.       Locate L2,P
  1441.       If K$<>"" Then Print Zone$(K$,X)
  1442.    Next 
  1443.    GMEN:
  1444.    IN=Mouse Zone
  1445.    If Mouse Key=1 and IN>0 and IN=<ANZ Then Goto GO
  1446.    Goto GMEN
  1447.    GO:
  1448.    LL=2*BLEN+4
  1449.    L1=(BREITE-LL)/2
  1450.    L2=L1+4+BLEN
  1451.    P=4
  1452.    ANZ1=ANZ/2
  1453.    If ANZ/2*2<ANZ Then ANZ1=ANZ1+1
  1454.    For X=1 To ANZ1
  1455.       P=P+2
  1456.       Locate L1,P
  1457.       If IN=X Then Inverse Off 
  1458.       Print ME$(X)
  1459.       If IN=X Then Inverse On 
  1460.    Next 
  1461.    P=4
  1462.    For X=ANZ1+1 To ANZ
  1463.       P=P+2
  1464.       Locate L2,P
  1465.       If IN=X Then Inverse Off 
  1466.       If ME$(X)<>"" Then Print ME$(X)
  1467.       If IN=X Then Inverse On 
  1468.    Next 
  1469.    Hide 
  1470.    Inverse Off 
  1471. End Proc[IN]
  1472. Procedure GC[P]
  1473.    Shared KK,AF,ML,NR,MX,B1,B2,SF
  1474.    Show : Curs Off 
  1475.    ANZ=1
  1476.    If P=0 Then ANZ=20
  1477.    Cls 1,0,219 To Screen Width,Screen Height
  1478.    Box 44,219 To 629,235
  1479.    Locate 9,28
  1480.    Print "|<     <<<      <<      <      STOP      >      >>      >>>      >|";
  1481.    If P=0 Then Cls 1,0,236 To 680,250 : Goto NOPR
  1482.    Box 44,236 To 629,250
  1483.    Locate 10,30
  1484.    Print "AUSDRUCK           L�SCHEN             ï¿½NDERN          DUPLIZIEREN ";""
  1485.    Box 44,235 To 190,250 : Set Zone 10,36,235 To 182,250
  1486.    Box 190,235 To 336,250 : Set Zone 11,190,235 To 336,250
  1487.    Box 336,235 To 482,250 : Set Zone 12,336,235 To 482,250
  1488.    Box 482,235 To 629,250 : Set Zone 13,482,235 To 629,250
  1489.    NOPR:
  1490.    Box 44,219 To 109,235 : Set Zone 1,44,219 To 109,235
  1491.    Box 109,219 To 174,235 : Set Zone 2,109,219 To 174,235
  1492.    Box 174,219 To 239,235 : Set Zone 3,174,219 To 239,235
  1493.    Box 239,219 To 304,235 : Set Zone 4,239,219 To 304,235
  1494.    Box 304,219 To 369,235 : Set Zone 5,304,219 To 369,235
  1495.    Box 369,219 To 434,235 : Set Zone 6,369,219 To 434,235
  1496.    Box 434,219 To 499,235 : Set Zone 7,434,219 To 499,235
  1497.    Box 499,219 To 564,235 : Set Zone 8,499,219 To 564,235
  1498.    Box 564,219 To 629,235 : Set Zone 9,564,219 To 629,235
  1499.    If P=0 and KK>1 Then Locate 3,28 : Print "<=" : Box 15,219 To 44,235 : Set Zone 14,15,219 To 44,235
  1500.    If P=0 and ML<AF Then Locate 79,28 : Print "=>" : Box 629,219 To 658,235 : Set Zone 15,629,219 To 658,235
  1501.    NR1=NR
  1502.    If P=0 Then NR1=NR1-20
  1503.    PMCHECK:
  1504.    If SF=0 Then If Mouse Key=2 Then NRFADER[ANZ,NR1,B1,B2] : NR1=Param : Z=NR1-NR : Goto NEWEX
  1505.    IN=Mouse Zone
  1506.    MK= Extension_22_0080(IN,1,13)
  1507.    MK2= Extension_22_0080(IN,1,9)
  1508.    MK3= Extension_22_0080(IN,14,15)
  1509.    If P=1 Then If Mouse Key=1 and MK=1 Then Goto PMCH
  1510.    If Mouse Key=1 and MK2=1 Then Goto PMCH
  1511.    If P=0 Then If Mouse Key=1 and MK3=1 Then Goto PMCH2
  1512.    Goto PMCHECK
  1513.    NEWEX:
  1514.    If P=0 Then Z=Z+20
  1515.    Goto NEWEX2
  1516.    PMCH2:
  1517.    If IN=14 Then KK=KK-1 : If KK<1 Then KK=1 : Goto PMCHECK
  1518.    If IN=15 Then KK=KK+1 : If ML=AF Then KK=KK-1 : Goto PMCHECK
  1519.    Z=5033
  1520.    PMCH:
  1521.    If IN=1 Then Z=-3000
  1522.    If IN=2 Then Z=-100
  1523.    If IN=3 Then Z=-20
  1524.    If IN=4 Then Z=-1
  1525.    If IN=5 Then Z=5000
  1526.    If IN=6 Then Z=1
  1527.    If IN=7 Then Z=20
  1528.    If IN=8 Then Z=100
  1529.    If IN=9 Then Z=3000
  1530.    If IN=10 Then Z=5072
  1531.    If IN=11 Then Z=5076
  1532.    If IN=12 Then Z=5196
  1533.    If IN=13 Then Z=5068
  1534.    NEWEX2:
  1535.    Hide 
  1536. End Proc[Z]
  1537. Procedure POSITION[NR]
  1538.    Shared B1,B2
  1539.    Fix(6)
  1540.    VSX#=Screen Width-2
  1541.    VMX0#=B1 : VMX1#=B2+1
  1542.    VNR#=NR : VMX#=VMX1#-VMX0#
  1543.    If VNR#<1 Then VNR#=1
  1544.    VX#=VMX#/VNR# : VV#=VMX#/VX# : VV#=VMX#/VV#
  1545.    VY#=VSX#-(VSX#/VV#)+1 : VY#=VSX#-VY#
  1546.    If VNR#=1 Then Ink 0 : Bar 1,0 To VSX#,5
  1547.    Ink 3 : Box 0,0 To VSX#+1,5
  1548.    If VY#>VSX# Then VY#=VSX#
  1549.    X1=1 : X2=VY# : If X1=>X2 Then X2=X1+1
  1550.    Ink 2 : Bar X1,1 To X2,4
  1551.    Fix(16)
  1552. End Proc
  1553. Procedure NRFADER[ANZ,NR1,MX0,MX1]
  1554.    Fix(6)
  1555.    VSX#=Screen Width-2
  1556.    SX=Screen Width-1
  1557.    HOEHE=Screen Height
  1558.    Get Block 241,0,0,Screen Width,HOEHE
  1559.    Cls 1,0,219 To Screen Width,HOEHE
  1560.    VMX0#=MX0 : VMX1#=MX1+1
  1561.    VNR#=NR1 : VMX#=VMX1#-VMX0#
  1562.    VANZ#=ANZ
  1563.    VPROP#=VMX#/VANZ#
  1564.    VPROP#=VSX#/VPROP#/2
  1565.    If VPROP#<1 Then VPROP#=1
  1566.    If VPROP#>VSX# Then VPROP#=VSX#
  1567.    NR$=Str$(NR1) : NR$=Right$(NR$,Len(NR$)-1)
  1568.    VX#=VMX#/VNR# : VV#=VMX#/VX# : VV#=VMX#/VV#
  1569.    VY#=VSX#-(VSX#/VV#)+1 : VY#=VSX#-VY#
  1570.    VP#=VY# : If VP#>VSX#-(Len(NR$)*8) Then VP#=VSX#-(Len(NR$)*8)
  1571.    REG:
  1572.    Text 0,HOEHE-16,Space$(Screen Width/8)
  1573.    Text VP#,HOEHE-16,NR$
  1574.    Ink 0 : Bar 1,HOEHE-12 To VSX#,HOEHE-2
  1575.    Ink 3 : Box 0,HOEHE-13 To VSX#+1,HOEHE-1
  1576.    V1#=VY#-VPROP# : If V1#<1 Then V1#=1
  1577.    V2#=VY#+VPROP# : If V2#>VSX# Then V2#=VSX#
  1578.    PROP=VPROP# : PROP=PROP/2
  1579.    X1=V1# : X2=V2# : If X1=>X2 Then X2=X1+1
  1580.    X1=Min(SX-PROP,X1) : X1=Max(1,X1-PROP) : X2=Min(SX,X2+PROP) : X2=Max(2+PROP,X2)
  1581.    Ink 2 : Bar X1,HOEHE-12 To X2,HOEHE-1
  1582.    While Mouse Key=2 : Wend 
  1583.    UNREG:
  1584.    If Mouse Key=2 Then Goto FEX
  1585.    If Mouse Key<>1 Then Goto UNREG
  1586.    Y=X Screen(X Mouse)
  1587.    If Y Screen(Y Mouse)<HOEHE-12 or Y Screen(Y Mouse)>HOEHE-1 Then Goto UNREG
  1588.    If Y<1 or Y>Screen Width-1 Then Goto UNREG
  1589.    VY#=Y
  1590.    VP#=VY#
  1591.    VSX#=VSX#-2
  1592.    If VY#=VSX# Then NR2=MX1 : Goto UNRECH
  1593.    VX#=VSX#/VY# : VV#=VSX#/VX# : VV#=VSX#/VV#
  1594.    VNR#=VMX#-(VMX#/VV#)+1 : VNR#=VMX#-VNR#
  1595.    NR2=VNR#
  1596.    NR2=NR2+MX0
  1597.    If NR2<MX0 Then NR2=MX0
  1598.    If NR2>MX1 Then NR2=MX1
  1599.    UNRECH:
  1600.    NR$=Str$(NR2) : NR$=Right$(NR$,Len(NR$)-1)
  1601.    If VP#>VSX#-(Len(NR$)*8) Then VP#=VSX#-(Len(NR$)*8)
  1602.    VSX#=VSX#+2
  1603.    Goto REG
  1604.    FEX:
  1605.    If NR2=0 Then NR2=NR1
  1606.    Put Block 241,0,0
  1607.    Del Block 241
  1608.    Fix(16)
  1609. End Proc[NR2]
  1610. Procedure DRUGERMAN[S$,PRLEN,PRAB]
  1611.    If PRLEN=0 Then Goto EXDRU
  1612.    U=0
  1613.    If Len(S$)>=PRLEN Then Y=PRLEN
  1614.    If Len(S$)<PRLEN Then Y=Len(S$) : U=1
  1615.    P$=""
  1616.    For X=1 To Y
  1617.       P$=P$+Mid$(S$,X,1)
  1618.    Next 
  1619.    P$= Extension_22_006C(P$,"{",",")
  1620.    P$= Extension_22_006C(P$,Chr$(228),"{")
  1621.    P$= Extension_22_006C(P$,Chr$(246),"|")
  1622.    P$= Extension_22_006C(P$,Chr$(252),"}")
  1623.    P$= Extension_22_006C(P$,Chr$(223),"~")
  1624.    P$= Extension_22_006C(P$,Chr$(196),"[")
  1625.    P$= Extension_22_006C(P$,Chr$(214),"\")
  1626.    P$= Extension_22_006C(P$,Chr$(220),"]")
  1627.    Print #4,P$;
  1628.    If U=1 Then Print #4,Space$(PRLEN-Len(S$));
  1629.    If PRAB>0 Then Print #4,Space$(PRAB);
  1630.    EXDRU:
  1631. End Proc
  1632. Procedure REQUESTER[A$,B$,C$]
  1633.    Show 
  1634.    BREITE=Screen Width : HOEHE=Screen Height
  1635.    HALB=BREITE/2 : TBREITE=BREITE/8 : HBREIT=TBREITE/2
  1636.    A=Len(A$)*8+60
  1637.    B=Len(B$)*8+60
  1638.    C=Len(C$)*8+60
  1639.    LASTLENG=Max(A,B+C)
  1640.    Get Block 241,0,0,BREITE,HOEHE
  1641.    Ink 0 : Bar HALB-LASTLENG/2+5,HOEHE-41 To HALB+LASTLENG/2+5,HOEHE-6
  1642.    Ink 1 : Bar HALB-LASTLENG/2,HOEHE-46 To HALB+LASTLENG/2,HOEHE-11
  1643.    Ink 2 : Box HALB-LASTLENG/2,HOEHE-46 To HALB+LASTLENG/2,HOEHE-11
  1644.    Locate 1,27 : Centre A$
  1645.    X1=HALB-LASTLENG/2+20 : X2=HALB-LASTLENG/2+B-20
  1646.    X3=HALB+LASTLENG/2-C+20 : X4=HALB+LASTLENG/2-20
  1647.    Box X1,HOEHE-27 To X2,HOEHE-15
  1648.    Box X3,HOEHE-27 To X4,HOEHE-15
  1649.    X Mouse=X Hard(X1+(X2-X1)/2) : Y Mouse=Y Hard(HOEHE-22)
  1650.    Curs Off 
  1651.    Locate HBREIT-(LASTLENG-60)/16,29 : Print Zone$(B$,1)
  1652.    Locate HBREIT+(LASTLENG-60)/16-Len(C$),29 : Print Zone$(C$,2)
  1653.    REQUES1:
  1654.    IN=Mouse Zone
  1655.    If Mouse Key=1 Then If IN<>0 Then Goto REQUES2
  1656.    Goto REQUES1
  1657.    REQUES2:
  1658.    Put Block 241,0,0
  1659.    Del Block 241
  1660.    Hide 
  1661. End Proc[IN]
  1662. Procedure MELDUNG[A$]
  1663.    Show : Curs Off : Change Mouse 1
  1664.    BREITE=Screen Width : HOEHE=Screen Height : HALB=BREITE/2
  1665.    B$=""
  1666.    IN=Instr(A$,Chr$(10))
  1667.    If IN Then B$=Mid$(A$,IN+1) : A$=Left$(A$,IN-1)
  1668.    X=Max(Len(B$),Len(A$))
  1669.    Y=HALB-18 : If X/2*2=X Then Y=HALB
  1670.    X=X*4+8
  1671.    Z=HOEHE-23 : If IN Then Z=HOEHE-31
  1672.    Get Block 241,0,0,BREITE,HOEHE
  1673.    Ink 0 : Bar Y-X+3,Z+3 To HALB+X+3,HOEHE-2
  1674.    Ink 1 : Bar Y-X,Z To HALB+X,HOEHE-5
  1675.    Ink 2 : Box Y-X,Z To HALB+X,HOEHE-5
  1676.    X=30 : If IN Then X=29
  1677.    Locate 1,X : Centre A$
  1678.    If IN Then Locate 1,30 : Centre B$
  1679.    Bell : Wait 50
  1680.    While Mouse Key<>1 : Wend 
  1681.    Put Block 241,0,0
  1682.    Del Block 241
  1683.    Hide 
  1684. End Proc
  1685. Procedure CHANGERGB
  1686.    Shared FC,BC
  1687.    NCOLS=Screen Colour
  1688.    Cls : Show 
  1689.    Dim RGB(4)
  1690.    Reserve Zone 40
  1691.    Ink 0,0
  1692.    Bar 13,8 To 217,112
  1693.    Ink FC,BC
  1694.    Bar 8,3 To 212,107
  1695.    Ink BC,FC
  1696.    Box 9,4 To 211,106
  1697.    Ink BC,FC
  1698.    A=0 : Repeat 
  1699.       Bar 15+A*20,6 To 30+A*20,104
  1700.       Set Zone A+1,15+A*20,6 To 30+A*20,104
  1701.       Inc A
  1702.    Until A=3
  1703.    A=0 : Repeat 
  1704.       Draw 10,6+A*6 To 75,6+A*6
  1705.       Inc A
  1706.    Until A=17
  1707.    A=0 : Repeat 
  1708.       Ink A,A : X=A mod 8 : Y=A/8
  1709.       Bar X*16+80,Y*16+8 To X*16+95,Y*16+23
  1710.       Set Zone A+4,X*16+80,Y*16+8 To X*16+95,Y*16+23
  1711.       RGB(A)=Colour(A)
  1712.    Inc A : Until A>=Min(32,NCOLS)
  1713.    Ink BC,FC
  1714.    Box 79,7 To 96+16*X,24+16*Y
  1715.    Box 80,75 To 140,85
  1716.    Text 91,83,"Reset"
  1717.    Box 152,75 To 202,85
  1718.    Text 162,83,"Save"
  1719.    Box 80,90 To 140,100
  1720.    Text 86,98,"Cancel"
  1721.    Box 152,90 To 202,100
  1722.    Text 165,98,"Use"
  1723.    Set Zone 39,152,75 To 202,85
  1724.    Set Zone 38,80,75 To 140,85
  1725.    Set Zone 36,80,90 To 140,100
  1726.    Set Zone 37,152,90 To 202,100
  1727.    Ink SELCOL
  1728.    Bar 195,58 To 201,67
  1729.    Ink BC : Box 194,57 To 202,68
  1730.    SFADERS[SELCOL]
  1731.    OK=0 : While OK=0
  1732.       While Mouse Key=0 : Wend : YM=Y Screen(Y Mouse) : Z=Mouse Zone
  1733.       If Extension_22_0080(Z,1,3)=1
  1734.          CFADERS[SELCOL,Z-1,YM]
  1735.          SFADERS[SELCOL]
  1736.       End If 
  1737.       If Extension_22_0080(Z,4,35)
  1738.          SELCOL=Z-4
  1739.          Ink SELCOL
  1740.          Bar 195,58 To 201,67
  1741.          SFADERS[SELCOL]
  1742.          Ink SELCOL
  1743.       End If 
  1744.       If Z=37
  1745.          OK=1
  1746.       End If 
  1747.       If Z=39
  1748.          Open Out 1,"df1:JDD.col"
  1749.          For X=0 To NCOLS-1
  1750.             Print #1,Colour(X)
  1751.          Next 
  1752.          Close 
  1753.          OK=1
  1754.       End If 
  1755.       If Z=36 Then Gosub RESET : OK=1
  1756.       If Z=38 Then Gosub RESET
  1757.    Wend 
  1758.    Pop Proc
  1759.    RESET:
  1760.    A=0 : Repeat 
  1761.       Colour A,RGB(A) : SPCOL[A,RGB(A)]
  1762.    Inc A : Until A>=Min(32,NCOLS)
  1763.    Return 
  1764. End Proc
  1765. Procedure CFADERS[S,F,YM]
  1766.    Dim R(2)
  1767.    C=Colour(S)
  1768.    R(0)=C/256
  1769.    R(1)=(C/16) mod 16
  1770.    R(2)=C mod 16
  1771.    V=Max(0,Min(15,15-(YM-7)/6))
  1772.    R(F)=V
  1773.    Colour S,(R(0)*256+R(1)*16+R(2))
  1774.    SPCOL[S,Colour(S)]
  1775. End Proc
  1776. Procedure SFADERS[S]
  1777.    Shared RGBO,BC,FC
  1778.    Dim R(2)
  1779.    C=RGBO
  1780.    R(0)=C/256
  1781.    R(1)=(C/16) mod 16
  1782.    R(2)=C mod 16
  1783.    Ink BC,BC
  1784.    A=0 : Repeat 
  1785.       V=(15-R(A))*6 : Bar 17+20*A,7+V To 28+20*A,12+V
  1786.       Inc A
  1787.    Until A=3
  1788.    C=Colour(S)
  1789.    RGBO=C
  1790.    R(0)=C/256
  1791.    R(1)=(C/16) mod 16
  1792.    R(2)=C mod 16
  1793.    Ink BC,FC
  1794.    Text 80,66,"Col"+Right$(" "+Str$(S),2)+" Val:$"+Right$("000"+Mid$(Hex$(RGBO),2),3)
  1795.    Ink FC,FC
  1796.    A=0 : Repeat 
  1797.       Ink FC,FC
  1798.       V=(15-R(A))*6 : Box 17+20*A,7+V To 28+20*A,12+V
  1799.       Ink S
  1800.       Bar 18+20*A,8+V To 27+20*A,11+V
  1801.       Inc A
  1802.    Until A=3
  1803. End Proc
  1804. Procedure SPCOL[A,B]
  1805.    If Length(1)>0
  1806.       Doke Start(1)+2+8*Length(1)+2*A,B
  1807.    End If 
  1808. End Proc
  1809. Procedure INVERS[LL]
  1810.    XC=X Curs : YC=Y Curs
  1811.    Inverse On 
  1812.    Print Space$(LL)
  1813.    Locate XC,YC
  1814.    Inverse Off 
  1815. End Proc
  1816. Procedure SET_COL
  1817.    If Exist("devs:JDD.col")
  1818.       Open In 1,"devs:JDD.col"
  1819.       For X=0 To 3
  1820.          Input #1,FW
  1821.          Colour X,FW
  1822.       Next 
  1823.       Close 1
  1824.    End If 
  1825. End Proc
  1826. Procedure TITEL
  1827.    Cls 1
  1828.    Locate 1,24 : Centre "Dieses Programm wurde in  A M O S  geschrieben"
  1829.    C=2
  1830.    WA2:
  1831.    If K=1 Then Goto RES
  1832.    If C=1 Then C=0
  1833.    If C<0 Then C=1 : K=1
  1834.    Ink C
  1835.    Pen C
  1836.    Locate 1,9
  1837.    Centre "Datei-Verwaltung" : Print : Print 
  1838.    Centre "(C) 19xx" : Print 
  1839.    Centre "C16-Version 1985" : Print 
  1840.    Centre "Amiga-Version 1991" : Print 
  1841.    Centre "J�rg  Dommermuth"
  1842.    X1=242 : X2=429
  1843.    Y1=70 : Y2=120
  1844.    Polyline X1,83 To X2,83
  1845.    WA:
  1846.    Wait 5
  1847.    Box X1,Y1 To X2,Y2
  1848.    X1=X1-10 : X2=X2+10
  1849.    Y1=Y1-5 : Y2=Y2+5
  1850.    If Y1=25 Then C=C-1 : Goto WA2
  1851.    Goto WA
  1852.    RES:
  1853.    Pen 2 : Ink 2
  1854. End Proc
  1855. Procedure WORKING
  1856.    Curs Off 
  1857.    BREITE=Screen Width : HOEHE=Screen Height : HALB=BREITE/2
  1858.    A$="Ich arbeite..."
  1859.    X=Len(A$)
  1860.    Y=HALB-18 : If X/2*2=X Then Y=HALB
  1861.    X=X*4+8
  1862.    Ink 0 : Bar Y-X+3,HOEHE-20 To HALB+X+3,HOEHE-2
  1863.    Ink 1 : Bar Y-X,HOEHE-23 To HALB+X,HOEHE-5
  1864.    Ink 2 : Box Y-X,HOEHE-23 To HALB+X,HOEHE-5
  1865.    Locate 1,30 : Centre A$
  1866. End Proc
  1867. Procedure WORKOFF
  1868.    Curs Off 
  1869.    BREITE=Screen Width : HOEHE=Screen Height : HALB=BREITE/2
  1870.    A$="   Fertig...  "
  1871.    X=Len(A$)
  1872.    Y=HALB-18 : If X/2*2=X Then Y=HALB
  1873.    X=X*4+8
  1874.    Ink 0 : Bar Y-X+3,HOEHE-20 To HALB+X+3,HOEHE-2
  1875.    Ink 1 : Bar Y-X,HOEHE-23 To HALB+X,HOEHE-5
  1876.    Ink 2 : Box Y-X,HOEHE-23 To HALB+X,HOEHE-5
  1877.    Locate 1,30 : Centre A$
  1878. End Proc
  1879. Procedure FILE_COPY[SOURCE$,DEST$]
  1880.    Shared MX,AF
  1881.    FIND_LENGTH[SOURCE$]
  1882.    FILE_LENGTH=Param
  1883.    LONG_FILE_COPY[SOURCE$,DEST$,FILE_LENGTH]
  1884. End Proc
  1885. Procedure FIND_LENGTH[SOURCE$]
  1886.    Open In 1,SOURCE$
  1887.    L=Lof(1)
  1888.    Close 
  1889. End Proc[L]
  1890. Procedure LONG_FILE_COPY[SOURCE$,DEST$,L]
  1891.    Shared MX,AF
  1892.    Open In 1,SOURCE$
  1893.    Open Out 2,DEST$
  1894.       MX=0 : KOMMA=0 : AF=1
  1895.       For X=1 To L
  1896.          T$=""
  1897.          T$=Input$(1,1)
  1898.          If T$=Chr$(34) Then If KOMMA=0 Then KOMMA=1 : Goto SKIP
  1899.          If T$=Chr$(34) Then If KOMMA=1 Then KOMMA=0
  1900.          SKIP:
  1901.          If KOMMA=1 Then If T$="," Then T$="{"
  1902.          If KOMMA=0 Then If T$="," Then T$="|" : AF=AF+1
  1903.          If T$=Chr$(34) Then T$=""
  1904.          If T$=Chr$(13) Then T$="|"+Chr$(13)+Chr$(10) : MX=MX+1 : BF=AF : AF=1
  1905.          If T$<>"" Then Print #2,T$;
  1906.       Next 
  1907.    Close 
  1908.    AF=BF
  1909. End Proc
  1910. Procedure AUTOSAVE
  1911.    Shared AKT
  1912.    If AKT=0 Then Timer=0
  1913.    If Timer<45000 Then Pop Proc
  1914.    MELDUNG["Es sind 15 Minuten vergangen!"+Chr$(10)+"Bitte Datei speichern!"]
  1915. End Proc
  1916. Procedure SET_TIME
  1917.    TM$= Extension_22_004C 
  1918.    UHR2:
  1919.    Cls 1 : Locate 23,5 : Print "Bitte Datum eingeben! ("+TM$+")"
  1920.    Locate 34,7 : Clear Key : Input Z$ : Curs Off 
  1921.    Z$= Extension_22_00E8(Z$)
  1922.    If Z$="" Then Locate 36,7 : Print TM$
  1923.    P= Extension_22_005A(Z$,".") : If P<>2 Then Pop Proc
  1924.    P= Extension_22_0080(Len(Z$),6,10) : If P=0 Then Pop Proc
  1925.    If Instr(Right$(Z$,4),".")=0 Then Z$=Left$(Z$,Len(Z$)-4)+Right$(Z$,2)
  1926.     Extension_22_002C(Z$)
  1927. End Proc